%%%-------------------------------------------------------------------
%%% Created : 29 Nov 2006 by Torbjorn Tornkvist <tobbe@tornkvist.org>
%%% Author  : Willem de Jong (w.a.de.jong@gmail.com).
%%% Desc    : A SOAP server.
%%%-------------------------------------------------------------------
-module(yaws_soap_srv).

-behaviour(gen_server).

%% API
-export([start_link/0,
	 setup/1, setup/2, setup/3,
	 handler/4
	]).

%% gen_server callbacks
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
	 terminate/2, code_change/3]).

-include("../include/yaws_api.hrl").
-include("../include/yaws.hrl").
-include("../include/soap.hrl").

-define(SERVER, ?MODULE).

%% State
-record(s, {
	  wsdl_list = []          % list of {Id, WsdlModel} tuples, where Id == {M,F}
	 }).

-define(OK_CODE, 200).
-define(BAD_MESSAGE_CODE, 400).
%% -define(METHOD_NOT_ALLOWED_CODE, 405).
-define(SERVER_ERROR_CODE, 500).

%%====================================================================
%% API
%%====================================================================
%%--------------------------------------------------------------------
%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
%% Description: Starts the server
%%--------------------------------------------------------------------
start_link() ->
    %% We are dependent on erlsom
    case code:ensure_loaded(erlsom) of
	{error, _} -> 
	    Emsg = "could not load erlsom",
	    error_logger:error_msg("~p: exiting, reason: ~s~n",
				   [?MODULE, Emsg]),
	    {error, Emsg};
	{module, erlsom} ->
	    gen_server:start_link({local, ?SERVER}, ?MODULE, [], [])
    end.

%%% To be called from yaws_rpc.erl
%%% Return according to yaws_rpc:eval_payload/6
handler(Args, Id, Payload, SessionValue) ->
    Headers = Args#arg.headers,
    SoapAction = yaws_soap_lib:findHeader("SOAPAction", Headers#headers.other),
    case gen_server:call(?SERVER, {request, Id, Payload, SessionValue, SoapAction}) of
	{ok, XmlDoc, ResCode, undefined} ->
	    {false, XmlDoc, ResCode};
	{ok, XmlDoc, ResCode, SessVal} ->
	    {true, 0, SessVal, XmlDoc, ResCode};
	{error, _, _} = Error ->
	    Error;
	false ->
	    false    % soap notify
    end.

%% Setup a SOAP interface according to the config file.
setup(ConfigFile) ->
    tbd.

setup(Id, WsdlFile) when tuple(Id),size(Id)==2 ->
    Wsdl = yaws_soap_lib:initModel(WsdlFile),
    gen_server:call(?SERVER, {add_wsdl, Id, Wsdl}).
    

setup(Id, WsdlFile, Prefix) when tuple(Id),size(Id)==2 ->
    Wsdl = yaws_soap_lib:initModel(WsdlFile, Prefix),
    gen_server:call(?SERVER, {add_wsdl, Id, Wsdl}).
    


%%====================================================================
%% gen_server callbacks
%%====================================================================

%%--------------------------------------------------------------------
%% Function: init(Args) -> {ok, State} |
%%                         {ok, State, Timeout} |
%%                         ignore               |
%%                         {stop, Reason}
%% Description: Initiates the server
%%--------------------------------------------------------------------
init([]) ->
    {ok, #s{}}.

%%--------------------------------------------------------------------
%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
%%                                      {reply, Reply, State, Timeout} |
%%                                      {noreply, State} |
%%                                      {noreply, State, Timeout} |
%%                                      {stop, Reason, Reply, State} |
%%                                      {stop, Reason, State}
%% Description: Handling call messages
%%--------------------------------------------------------------------
handle_call({add_wsdl, Id, WsdlModel}, _From, State) ->
    NewWsdlList = uinsert({Id, WsdlModel}, State#s.wsdl_list),
    {reply, ok, State#s{wsdl_list = NewWsdlList}};
%%
handle_call( {request, Id, Payload, SessionValue, SoapAction}, _From, State) ->
    Reply = request(State, Id, Payload, SessionValue, SoapAction),
    {reply, Reply, State}.

%%--------------------------------------------------------------------
%% Function: handle_cast(Msg, State) -> {noreply, State} |
%%                                      {noreply, State, Timeout} |
%%                                      {stop, Reason, State}
%% Description: Handling cast messages
%%--------------------------------------------------------------------
handle_cast(_Msg, State) ->
    {noreply, State}.

%%--------------------------------------------------------------------
%% Function: handle_info(Info, State) -> {noreply, State} |
%%                                       {noreply, State, Timeout} |
%%                                       {stop, Reason, State}
%% Description: Handling all non call/cast messages
%%--------------------------------------------------------------------
handle_info(_Info, State) ->
    {noreply, State}.

%%--------------------------------------------------------------------
%% Function: terminate(Reason, State) -> void()
%% Description: This function is called by a gen_server when it is about to
%% terminate. It should be the opposite of Module:init/1 and do any necessary
%% cleaning up. When it returns, the gen_server terminates with Reason.
%% The return value is ignored.
%%--------------------------------------------------------------------
terminate(_Reason, _State) ->
    ok.

%%--------------------------------------------------------------------
%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
%% Description: Convert process state when code is changed
%%--------------------------------------------------------------------
code_change(_OldVsn, State, _Extra) ->
    {ok, State}.

%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------

request(State, {M,F} = Id, Payload, SessionValue, Action) ->
    {ok, Model} = get_model(State, Id),
    Umsg = (catch erlsom_lib:toUnicode(Payload)),
    case catch yaws_soap_lib:parseMessage(Umsg, Model) of
	{ok, Header, Body} -> 
	    %% call function
	    result(Model, catch apply(M, F, [Header, Body, Action, SessionValue]));
	{error, Error} ->
	    cli_error(Error);
	OtherError -> 
	    srv_error(io_lib:format("Error parsing message: ~p", [OtherError]))
    end.

%%% Analyse the result and produce some output
result(Model, {ok, ResHeader, ResBody, ResCode, SessVal}) ->
    return(Model, ResHeader, ResBody, ResCode, SessVal);
result(Model, {ok, ResHeader, ResBody}) ->
    return(Model, ResHeader, ResBody, ?OK_CODE, undefined);
result(_Model, {error, client, ClientMssg}) ->
    cli_error(ClientMssg);
result(_Model, false) ->   % soap notify !
    false;
result(_Model, Error) ->
    srv_error(io_lib:format("Error processing message: ~p", [Error])).

return(#wsdl{model = Model}, ResHeader, ResBody, ResCode, SessVal) ->
    return(Model, ResHeader, ResBody, ResCode, SessVal);
return(Model, ResHeader, ResBody, ResCode, SessVal) when not is_list(ResBody) ->
    return(Model, ResHeader, [ResBody], ResCode, SessVal);
return(Model, ResHeader, ResBody, ResCode, SessVal) ->
    %% add envelope
    Header2 = case ResHeader of
		  undefined -> undefined;
		  _         -> #'soap:Header'{choice = ResHeader}
	      end,
    Envelope = #'soap:Envelope'{'Body' =  #'soap:Body'{choice = ResBody},
				'Header' = Header2},
    case catch erlsom:write(Envelope, Model) of
	{ok, XmlDoc} ->
	    {ok, XmlDoc, ResCode, SessVal};
	{error, WriteError} ->
	    srv_error(f("Error writing XML: ~p", [WriteError]));
	OtherWriteError ->
	    error_logger:error_msg("~p(~p): OtherWriteError=~p~n", 
				   [?MODULE, ?LINE, OtherWriteError]),
	    srv_error(f("Error writing XML: ~p", [OtherWriteError]))
    end.

f(S,A) -> lists:flatten(io_lib:format(S,A)).

cli_error(Error) -> 
    error_logger:error_msg("~p(~p): Cli Error: ~p~n", 
			   [?MODULE, ?LINE, Error]),
    Fault = yaws_soap_lib:makeFault("Client", "Client error"),
    {error, Fault, ?BAD_MESSAGE_CODE}.

srv_error(Error) -> 
    error_logger:error_msg("~p(~p): Srv Error: ~p~n", 
			   [?MODULE, ?LINE, Error]),
    Fault = yaws_soap_lib:makeFault("Server", "Server error"),
    {error, Fault, ?SERVER_ERROR_CODE}.
   



get_model(State, Id) ->
    case lists:keysearch(Id, 1, State#s.wsdl_list) of
	{value, {_, Model}} -> {ok, Model};
	_                   -> {error, "model not found"}
    end.

uinsert({K,_} = E, [{K,_}|T]) -> [E|T];
uinsert(E, [H|T])             -> [H|uinsert(E,T)];
uinsert(E, [])                -> [E].




